This article is an extension of article on Geocoding. This article will help to understand basic concept behind GPS system and its other counterparts like Russian GLONASS System and Indian IRNSS.In order to calculate distance between two different geographical sites we will use their Latitude and Longitude Co-ordinates. As shown in screen below to complete this article. First create a table (tblGeoCoding) along with few fields.

Now in next step create a simple form (frmFatchData) , As shown in screen below form will also contain a subform (Bounded to table created above) and a Button (with Caption Fetch Coordinates).

As shown in above figure, there is a separate section to calculate distance between two points using source and target latitude and longitude. Distance will be calculated in Kilometres (KM) and Nautical miles (NM).

To calculate latitude and Longitude of a particular geographical location, first user needs to fill following information as shown in screen below.

After filling all above details user needs to click on Fetch Coordinate Button. As result will be captured into remaining half of above screen. Now to calculate distance between two location use source (latitude, longitude) and target (latitude, longitude). After entering these values use Distance Calculation button to calculate distance (screen shown below).

VBA Code:-

Code associated with On Click event of Distance CalculationButton.

Private Sub CmdCalcDist_Click()
Dim theta, dist, lon1, lon2, lat1, lat2
lon1 = Me.TxtSrcLong
lon2 = Me.TxttarLong
lat1 = Me.txtSrclat
lat2 = Me.TxttarLat
theta = lon1 - lon2
dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
dist = acos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
Select Case Me.CmbUnit
Case "KM"
dist = dist * 1.609344
Case "NM"
dist = dist * 0.8684
End Select
Me.TxtDist = Round(dist, 2)
End Sub
Function acos(Rad)
If Abs(Rad) <> 1 Then
acos = Pi / 2 - Atn(Rad / Sqr(1 - Rad * Rad))
ElseIf Rad = -1 Then
acos = Pi
End If
End Function
Function deg2rad(Deg)
deg2rad = CDbl(Deg * Pi / 180)
End Function
Function rad2deg(Rad)
rad2deg = CDbl(Rad * 180 / Pi)
End Function

VBA Code:-

Code associated with On Click event of Fetch Coordinate Button.

Private Sub fatchCoordinates_Click()
Dim tGeoObj As tGeocodeAddressResult, rst As Recordset
DoCmd.Hourglass True
If DCount("ID", "tblGeoCoding") = 0 Then
MsgBox "Enter Address to Calculate latitude and longitude", vbInformation, "information"
DoCmd.Hourglass False
Exit Sub
End If
Set rst = CurrentDb.OpenRecordset("Select * from tblGeoCoding")
While Not rst.EOF
tGeoObj = GeocodeAddress(rst!Address, , rst!zip, rst!State, rst!Country)
With tGeoObj
rst.Edit
rst!Latitude = .dLatitude
rst!Longitude = .dLongitude
rst!Accuracy = .sAccuracy
rst!status = .sStatus
rst.Update
End With
rst.MoveNext
Wend
Me.SubfrmGeoCOding.Requery
rst.Close
DoCmd.Hourglass False
End Sub

We have created a Module named MdlGeoCoding. This module composed of main functionality to enriching description of a given location.

Public Type tGeocodeAddressResult
dLatitude As Double
dLongitude As Double
sRetAddress As String
sAccuracy As String
sStatus As String
End Type
Public Function GeocodeAddress(Optional ByVal vAddress As Variant = Null, Optional ByVal vTown As Variant = Null, Optional ByVal vPostCode As Variant = Null, Optional ByVal vRegion As Variant = Null, Optional ByVal sCountry As String) As tGeocodeAddressResult
On Error GoTo ErrHndlr
Dim oXmlDoc As Object
Dim strUrl As String, sFormatAddress As String
If Not IsNull(vAddress) Then vAddress = Replace(vAddress, ",", " ")
sFormatAddress = (vAddress + ",") & (vTown + ",") & (vRegion + ",") & (vPostCode + ",") & sCountry
strUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address=" & sFormatAddress & "&sensor=false"
Set oXmlDoc = CreateObject("Microsoft.XMLDOM")
With oXmlDoc
.async = False
If .Load(strUrl) And Not .selectSingleNode ("GeocodeResponse/status") Is Nothing Then
GeocodeAddress.sStatus = .selectSingleNode ("GeocodeResponse/status").Text
If Not .selectSingleNode ("GeocodeResponse/result") Is Nothing Then
GeocodeAddress.sRetAddress = .selectSingleNode ("//formatted_address").Text
GeocodeAddress.sAccuracy = .selectSingleNode ("//location_type").Text
GeocodeAddress.dLatitude = Val(.selectSingleNode("//location/lat").Text)
GeocodeAddress.dLongitude = Val(.selectSingleNode("//location/lng").Text)
End If
End If
End With
Set oXmlDoc = Nothing
Exit Function
ErrHndlr:
Set oXmlDoc = Nothing
Err.Raise Err.Number, , Err.Description
End Function